Przejazdy - Wizualizacje

---

Założenia projektu

Projekt został stworzony w celu wykonania wizualizacji na podstawie danych dotyczących ruchu rowerowego w Gdańsku. Ruch rowerowy monitorowany jest za pomocą stacji pomiarowych umiejscowionych w różnych miejscach w mieście. Zakres analizy obejmuje przedział czasowy od 01.10.2013 do 31.03.2021 roku. Projekt zakłada stworzenie wizualizacji na podstawie dziewięciu poleceń. Do pierwszych dwóch poleceń zostaną wykorzystane wykresy z R Graphics, natomiast pozostałe polecenia zostaną wykonane przy pomocy pakietu ggplot2 oraz jego rozszerzeń.

---

Utworzenie i modyfikacja zmiennych

Zostały utworzone zmienne takie jak: Month, Year, Day, Dzie_tyg, Czy_Weekend oraz Pora_Roku na podstawie zmiennej Data, a także został zmieniony typ nowych zmiennych na factor.

przejazdy$Month <- month(ymd(przejazdy$Data)) 
przejazdy$Year <- year(ymd(przejazdy$Data))
przejazdy$Day <- day(ymd(przejazdy$Data))
przejazdy$Dzien_tyg <- as.character(przejazdy$Data, format = "%A")
przejazdy$Czy_Weekend <- ifelse(przejazdy$Dzien_tyg %in% c("sobota", "niedziela"),"weekend", "dzień powszedni")

przejazdy <- przejazdy %>%
  mutate(Month = factor(Month), Year = factor(Year), Day = factor(Day), 
         Dzien_tyg = factor(Dzien_tyg), Czy_Weekend = factor(Czy_Weekend))

przejazdy$Pora_Roku <- ifelse(przejazdy$Month %in% c("12", '1', '2'), 'Zima', 
                              ifelse(przejazdy$Month %in% c("3", '4', '5'), 'Wiosna',
                              ifelse(przejazdy$Month %in% c("6", '7', '8'), 'Lato', 'Jesień')))

przejazdy$Pora_Roku <- as.factor(przejazdy$Pora_Roku)

levels(przejazdy$Month) <- c('1' = 'Styczeń', '2' = 'Luty', '3' = 'Marzec',
                              '4' = 'Kwiecień', '5' = 'Maj', '6' = 'Czerwiec',
                              '7' = 'Lipiec', '8' = 'Sierpień', '9' = 'Wrzesień',
                              '10' = 'Październik', '11' = 'Listopad', '12' = 'Grudzień')

punkty <- rename(punkty, Stacja = stacja)

---

Polecenie 1.

Przedstawić rozkład liczby dni pomiarowych w poszeczególnych punktach.

zad1 <- przejazdy[,c(1,3)]

zad1 <- zad1 %>%
  group_by(Stacja) %>%
  summarise(Liczba_dni = n()) %>%
  arrange(desc(Liczba_dni))


par(mar=c(5, 11, 4, 2))
barplot(sort(zad1$Liczba_dni),
        names.arg = zad1$Stacja[order(zad1$Liczba_dni)],
        main = "Rozkład liczby dni według punktu pomiarowego",
        xlab = "Liczba dni",
        space = 0.3,
        col = rev(viridis(35)),
        horiz=T,
        cex.names=0.8,
        las=1,
        font.axis = 3,
        font.lab = 2)

---

Polecenie 2.

Dla wybranego punktu przedstawić rozkład liczby przejazdów.

zad2 <- przejazdy[,c(1,2,3)]

zad2 <- zad2 %>%
  filter(Stacja == "Pas Nadmorski")

par(mar=c(5, 5, 4, 2))
hist(zad2$Licznik,
     main="Rozkład liczby przejazdów w punkcie pomiarowym Pas Nadmorski",
     xlab="Liczba przejazdów",
     ylab = "Częstość",
     col="darkorange1",
     border = "black",
     breaks = seq(0,12000,500),
     xlim = c(0,12500),
     las = 1,
     font.axis = 3,
     font.lab = 2)

---

Polecenie 3.

Porównać punkty pod względem natężenia / rozkładu przejazdów.

Porównanie względen natężenia

zad3 <- przejazdy %>%
  group_by(Stacja) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1)) %>%
  arrange(desc(Natezenie))
  
zad3

## # A tibble: 27 x 4
##    Stacja                     Liczba_dni Suma_przejazdow Natezenie
##    <fct>                           <int>           <dbl>     <dbl>
##  1 Pas Nadmorski                    2678        6765929      2526.
##  2 al. Zwycięstwa                   2739        6249800      2282.
##  3 ul. 3 Maja                       2647        4102298      1550.
##  4 al. Grunwaldzka (Wrzeszcz)       2678        3861112      1442.
##  5 ul. Kartuska                     1582        1899110.     1200.
##  6 al. Grunwaldzka (UG)             2313        2636624      1140.
##  7 ul. Chłopska                     1613        1824906      1131.
##  8 Błędnik                          2037        2250485      1105.
##  9 al. Hallera                      1978        2176510      1100.
## 10 al. Rzeczpospolitej              1613        1477426       916.
## # ... with 17 more rows

ggplot(zad3, aes(x = reorder(Stacja, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = heat.colors(27), alpha = 0.8) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 3000, 500)) +
  annotate(geom = 'rect',
           xmin = 0.5, xmax = 3.5,
           ymin = 0.5, ymax = 2600,
           fill = 'green',
           alpha = 0.4) +
  annotate("text", x = 7.5, y = 2400, label = "Stacje o największym natężeniu") +
  annotate(geom = 'rect',
           xmin = 24.5, xmax = 27.5,
           ymin = 0.5, ymax = 400,
           fill = 'pink',
           alpha = 0.6) +
  annotate("text", x = 23.5, y = 500, label = "Stacje o najniższym natężeniu") +
  xlab("Stacja") +
  ylab("Natężenie") +
  ggtitle('Natężenie ruchu rowerowego w zależności od stacji')

Porównanie względem rozkładu dla wybranych stacji

zad3.1 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
         Stacja == "ul. Jaśkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego" |
         Stacja == "al. Havla" | Stacja == "al. Żołnierzy Wyklętych" | Stacja == "ul. 3 Maja")

Za pomocą histogramu

ggplot(zad3.1, aes(x = Licznik, fill = Stacja)) + geom_histogram(binwidth = 600, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Stacja) +
  scale_x_continuous(breaks = seq(0, 12000, 1500)) +  
  xlab("Liczba przejazdów") +
  ylab("Liczebność") +
  ggtitle('Rozkłady liczby przejazdów dla wybranych stacji') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 12),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Za pomocą wykresu z pakietu ggridges

ggplot(zad3.1, aes(x = Licznik, y = Stacja, fill = Stacja)) +
  geom_density_ridges(scale = 2, show.legend = F) +  
  theme_ridges()

Za pomocą wykresu skrzynkowego

ggplot(zad3.1, aes(x = Stacja, y = Licznik, fill = Stacja)) + geom_boxplot(show.legend = F) +
  xlab("Stacja") + ylab("Licznik") + ggtitle("Rozkład liczby przejazdów względem wybranej stacji") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif"))

---

Polecenie 4.

Przedstawić natężenie / rozkład przejazdów dla wybranej stacji (Pas Nadmorski) w zależności od miesiąca / dnia tygodnia / dni powszednich / weekendowych.

Natężenie a miesiąc

zad4 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski") %>%
  group_by(Month) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1))


ggplot(zad4, aes(x = reorder(Month, -Natezenie), y = Natezenie)) + geom_bar(stat="identity", fill = 'slateblue', alpha = 0.8) +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
    axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 6000, 500)) +
  annotate(geom = 'rect',
           xmin = 0.5, xmax = 3.5,
           ymin = 0.5, ymax = 5900,
           fill = 'green',
           alpha = 0.4) +
  annotate("text", x = 5.5, y = 5400, label = "Miesiące o największym natężeniu") +
  annotate(geom = 'rect',
           xmin = 9.5, xmax = 12.5,
           ymin = 0.5, ymax = 800,
           fill = 'pink',
           alpha = 0.6) +
  annotate("text", x = 10.5, y = 1150, label = "Miesiące o najniższym natężeniu") +
  xlab("Miesiąc") +
  ylab("Natężenie") +
  ggtitle('Natężenie ruchu rowerowego w zależności od miesiąca')

Natężenie a typ dnia i pora roku

zad4.1 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski") %>%
  group_by(Czy_Weekend, Pora_Roku) %>%
  summarise(Liczba_dni = n(), 
            Suma_przejazdow = sum(Licznik), 
            Natezenie = round(Suma_przejazdow / Liczba_dni,1))

ggplot(zad4.1, aes(x = Czy_Weekend, y = Natezenie, fill = Czy_Weekend)) + geom_col(alpha = 0.8) +
  geom_label(aes(x = Czy_Weekend, y = Natezenie, label = Natezenie)) +
  scale_fill_manual(values = c('orangered3', 'royalblue2')) +
  theme_bw() + 
  theme(axis.title.x=element_blank(),
        axis.title.y = element_text(color="Grey40", size=16),
        strip.background = element_rect(colour = "black", fill = 'lightyellow2'),
        strip.text = element_text(face = "italic", size = 10),
        legend.position = "none",
        plot.title = element_text(color="grey40", face = "bold", size=19, family="serif")) +
  scale_y_continuous(breaks = seq(0, 8000, 1000)) + facet_wrap(~Pora_Roku)

Rozkład a miesiąc

zad4.2 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski")

ggplot(zad4.2, aes(x = Licznik, fill = Month)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Month) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdów") +
  ylab("Liczebność") +
  theme_bw() +
  ggtitle('Rozkłady liczby przejazdów w zależności od miesiąca') +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Rozkład a dzień tygodnia

ggplot(zad4.2, aes(x = Licznik, fill = Dzien_tyg)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Dzien_tyg) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdów") +
  ylab("Liczebność") +
  ggtitle('Rozkłady liczby przejazdów w zależności od dnia tygodnia') +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Rozkład a weekend

histweek <- ggplot(zad4.2, aes(x = Licznik, fill = Czy_Weekend)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Czy_Weekend) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdów") +
  ylab("Liczebność") +
  ggtitle('Jako histogram') +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

boxweek <- ggplot(zad4.2, aes(y = Licznik, fill = Czy_Weekend)) + geom_boxplot(show.legend = F, alpha = 0.8) + 
  facet_wrap(~Czy_Weekend) +
  scale_y_continuous(breaks = seq(0, 12000, 2000)) +
  ylab("Liczba przejazdów") +
  ggtitle('Jako wykres skrzynkowy') +
  theme_bw() +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        axis.text.x=element_blank(),
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

grid.arrange(boxweek, histweek)

Rozkład a pora roku

ggplot(zad4.2, aes(x = Licznik, fill = Pora_Roku)) + geom_histogram(binwidth = 800, show.legend = F, alpha = 0.8) + 
  facet_wrap(~Pora_Roku) +
  scale_x_continuous(breaks = seq(0, 12000, 2000)) +  
  xlab("Liczba przejazdów") +
  ylab("Liczebność") +
  ggtitle('Rozkłady liczby przejazdów w zależności od pory roku') +
  scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

---

Polecenie 5.

Porównać stacje pod względem zależności z poprzedniego punktu.

Porównanie wszystkich stacji na podstawie średniej liczby przejazdów

ggplot(data = przejazdy) +
  geom_line(stat = "summary",
            fun = mean,
            mapping =aes(x = Month, 
                         y = Licznik,
                         group = Dzien_tyg,
                         color = Dzien_tyg,
                         linetype = Czy_Weekend)) + 
  facet_wrap(facets = vars(Stacja),
             scales = "free_y") +
  theme_minimal() + 
  theme(axis.text.x = element_text(angle = 70, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        legend.title = element_text(size=10.5),
        legend.text = element_text(size=8.5),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey88",
                                         size=0.5, linetype="solid", 
                                         colour ="darkslateblue"),
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Licznik") + xlab("Miesiąc") +
  ggtitle('Porównanie stacji w zależności od średniej liczby przejazdów')

Porównanie wybranych stacji

zad5 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == 'al. Grunwaldzka (UG)' |  
           Stacja == "al. Hallera" | Stacja == "ul. Jaśkowa Dolina")

ggplot(zad5, aes(x = Pora_Roku, y = Licznik, fill=Pora_Roku)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
  theme_bw() + ylab("Licznik") + 
  ggtitle("Wybrane stacje ze względu na porę roku") +
  scale_fill_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  theme(axis.title.y = element_text(color="Grey23", size=16),
        axis.text.y = element_text(size=10),
        axis.title.x=element_blank(),
        legend.title = element_text(size=12),
        legend.text = element_text(size=8),
        legend.position = "none",
        plot.title = element_text(color="grey30", size=22, family="serif"))

ggplot(zad5, aes(x = Czy_Weekend, y = Licznik, fill=Czy_Weekend)) + geom_boxplot(size=1.2, alpha=0.5) + facet_grid(~Stacja) +
  theme_bw() + ylab("Licznik") + 
  ggtitle("Wybrane stacje ze względu na dzień tygodnia") +
  theme(axis.title.y = element_text(color="Grey23", size=16),
        axis.text.y = element_text(size=10),
        axis.title.x=element_blank(),
        legend.title = element_text(size=12),
        legend.text = element_text(size=8),
        legend.position = "none",
        plot.title = element_text(color="grey30", size=22, family="serif"))

---

Polecenie 6.

Dla wybranej stacji (Pas Nadmorski) przedstawić zależność między liczbą przejazdów a wybranymi warunkami pogodowymi.

zad6 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski")

ggplot(zad6, aes(x = Temperatura, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("Zależność liczby przejazdów i temperatury") + xlab("Temperatura [C]") + ylab("Liczba przejazdów") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.title = element_text(size=12),
        legend.text = element_text(size=10),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey88",
                                         size=0.5, linetype="solid", 
                                         colour ="grey40"),
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Wilgotność, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("Zależność liczby przejazdów i wilgotności") + xlab("Wilgotność [%]") + ylab("Liczba przejazdów") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Ciśnienie_stacja, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("Zależność liczby przejazdów i ciśnienia powietrza") + xlab("Ciśnienie powietrza [hPa]") + ylab("Liczba przejazdów") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Zachmurzenie, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("Zależność liczby przejazdów i zachmurzenia") + xlab("Zachmurzenie [oktanty]") + ylab("Liczba przejazdów") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

ggplot(zad6, aes(x = Wiatr, y = Licznik, color = Pora_Roku, shape = Czy_Weekend)) + geom_point(size = 3, alpha=0.7) +
  theme_minimal() +
  scale_color_manual(values = c('sandybrown', 'firebrick3', 'palegreen3', 'lavender')) +
  ggtitle("Zależność liczby przejazdów i siły wiatru") + xlab("Wiatr [m/s]") + ylab("Liczba przejazdów") +
  theme(axis.title.y = element_text(color="Grey23", size=15),
        axis.text.y = element_text(size=12),
        axis.title.x = element_text(color="Grey23", size=15),
        axis.text.x = element_text(size=12),
        legend.position = "none",
        plot.title = element_text(color="grey40", size=25, family="serif"))

---

Polecenie 7.

Porównać stacje (wybrane) pod względem zależności z poprzedniego punktu.

W tym celu została stworzona animacja za pomocą pakietu gganimate.

zad7 <- przejazdy %>%
  filter(Stacja == "Pas Nadmorski" | Stacja == "ul. Kartuska" | Stacja == "al. Hallera" |
           Stacja == "ul. Jaśkowa Dolina" | Stacja == "ul. Wita Stwosza" | Stacja == "ul. Sucharskiego")

chartZad7 <- ggplot(zad7, aes(x = Temperatura, y = Licznik, color = Stacja, size = Wiatr)) + 
  geom_point(alpha = 0.7, stroke = 1) + 
  theme_minimal() +
  labs(title = "Zależność temperatury od liczby przejazdów w czasie",
       x = "Temperatura [C]",
       y = "Liczba przejazdów") +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        legend.title = element_text(size=10.5),
        legend.text = element_text(size=8.5),
        legend.position = "right",
        legend.justification = c(0.94,0.94),
        legend.background = element_rect(fill="grey98",
                                         size=0.5, linetype="solid", 
                                         colour ="grey50"),
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  scale_color_brewer(palette = 'Set2')

mojaAnimacja <- chartZad7 +
  transition_time(Data) +
  labs(subtitle = "Dzień: {frame_time}") +
  shadow_wake(wake_length = 0.1)

animate(mojaAnimacja, height = 750, width = 900, nframes= 150, fps = 15, duration = 40, end_pause = 30, res = 100)

anim_save("mojaAnimacja.gif")

---

Polecenie 8.

Nanieść na mapę wybrane statystyki dotyczące przejazdów w punktach pomiarowych

statystyki <- przejazdy %>%
  group_by(Stacja) %>%
  summarise("Srednia" = mean(Licznik),
            "Odchylenie standardowe" = sd(Licznik),
            "Minimum" = min(Licznik),
            "Kwartyl 1" = quantile(Licznik, 0.25),
            "Mediana" = median(Licznik),
            "Kwartyl 3" = quantile(Licznik, 0.75),
            "Maksimum" = max(Licznik))

statystyki %>%
  kbl(caption = "Podstawowe statystyki dla stacji pomiarowych") %>%
  kable_styling(bootstrap_options = c("hover", "condensed")) %>%
  kable_paper()

Podstawowe statystyki dla stacji pomiarowych

Stacja	Srednia	Odchylenie standardowe	Minimum	Kwartyl 1	Mediana	Kwartyl 3	Maksimum
Pas Nadmorski	2526.4858	2348.6505	42.0000	624.25	1556.5	4147.75	11493
al. Zwycięstwa	2281.7817	1684.0541	32.0000	802.00	1821.0	3689.50	6968
ul. 3 Maja	1549.7915	1040.0276	0.0000	609.00	1339.0	2430.00	4489
al. Grunwaldzka (Wrzeszcz)	1441.7894	1008.9708	30.0000	560.00	1214.0	2207.75	4428
Błędnik	1104.8036	846.2111	23.0000	374.00	803.0	1819.00	3257
al. Hallera	1100.3589	881.1915	17.0000	353.25	756.0	1807.25	3969
ul. Chłopska	1131.3738	775.3459	23.0000	454.00	877.0	1792.00	3097
al. Grunwaldzka (UG)	1139.9153	803.1204	23.0000	447.00	936.0	1719.00	3777
ul. Kartuska	1200.4487	915.1864	22.7269	393.25	924.0	1937.25	3806
Kanał Raduni	845.3109	680.3250	10.0000	268.25	607.0	1369.00	2747
al. Rzeczpospolitej	915.9492	673.8896	9.0000	330.00	700.0	1485.00	2728
ul. Kołobrzeska	417.4041	316.3826	2.0000	153.00	299.0	677.00	1271
al. Havla	556.0905	468.3807	0.0000	152.00	386.5	933.50	2078
ul. Łostowicka	518.7133	398.4997	10.0000	169.00	400.0	837.75	1601
ul. Jaśkowa Dolina	456.5970	343.1822	19.0000	153.00	355.0	726.00	1468
ul. Nowolipie	426.3689	330.8752	6.0000	140.00	318.0	700.00	1468
ul. Kliniczna	395.0942	300.0793	0.0000	133.00	297.0	651.00	1632
ul. Wyzwolenia	359.8239	302.2553	0.0000	108.00	221.0	621.00	1733
ul. Rybińskiego	372.7545	289.8148	0.0000	134.00	269.0	603.00	1425
al. Żołnierzy Wyklętych	351.3504	255.8096	7.0000	126.00	272.0	568.00	1058
ul. Stryjewskiego	314.1943	258.3993	0.0000	93.00	215.0	525.00	1148
ul. Wita Stwosza	289.7849	209.5101	0.0000	107.75	245.0	447.00	1001
al. Jana Pawła II	296.4346	235.1679	0.0000	96.00	219.0	470.00	1050
ul. Sucharskiego	176.6255	157.5612	0.0000	51.00	109.0	288.00	838
ul. Elbląska	175.3428	137.3663	0.0000	58.00	122.0	295.00	619
Karczemki	345.9585	270.3222	10.0000	111.00	257.0	555.00	1213
ul. Słowackiego (Matarnia)	220.8628	171.5084	6.0000	74.00	162.0	356.00	724

punkty <- left_join(x = punkty,
                    y = statystyki,
                    by = "Stacja")

Stacja a średnia liczba przejazdów

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Srednia", 
             scale = 6,
             col = "royalblue3",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

Stacja a mediana liczby przejazdów

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Mediana", 
             scale = 6,
             col = "salmon3",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

Stacja a maksymalna liczba przejazdów

tmap_mode("view")
tm_shape(punkty) +
  tm_symbols(size = "Maksimum", 
             scale = 6,
             col = "darkorchid2",
             alpha = 0.7) +
  tm_basemap(providers$OpenStreetMap)

---

Polecenie 9.

Przedstawić zależności między zmiennymi opisującymi warunki pogodowe.

Za pomocą ggcorrplot() oraz geom_hex()

zad9 <- przejazdy[, c(4:12)]
pogodaKor <- round(cor(zad9),2)
ggcorrplot(pogodaKor, hc.order = TRUE, type = "lower",
           outline.col = "white", colors = c('coral2', 'azure1', 'palegreen2'), lab = T)

ggplot(zad9, aes(x = Zachmurzenie, y = Wilgotność)) + geom_hex(bins = 60) + 
  scale_fill_gradient(low = "lightsteelblue1", high = "springgreen3") +
  theme_minimal() + 
  ylab("Zachmurzenie [oktany]") + ylab("Wilgotność [%]") +
  ggtitle('Zależność pomiędzy wilgotnością i zachmurzeniem') + 
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Ciśnienie_stacja, y = Ciśnienie_morze)) + geom_hex(bins = 80) + 
  scale_fill_gradient(low = "khaki3", high = "darkorchid2") + 
  theme_minimal() + 
  ylab("Ciśnienie morza [hPa]") + xlab("Ciśnienie powietrza [hPa]") +
  ggtitle('Zależność pomiędzy ciśnienem morza i powietrza') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Temperatura, y = Wilgotność)) + geom_hex(bins = 70) + 
  scale_fill_gradient(low = "deepskyblue2", high = "firebrick3") +
  theme_minimal() + 
  ylab("Wilgotność [%]") + xlab("Temperatura [C]") +
  ggtitle('Zależność pomiędzy wilgotnością i temperaturą') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Temperatura, y = Ciśnienie_woda)) + geom_hex(bins = 70)  + 
  scale_fill_gradient(low = "cadetblue2", high = "goldenrod3") +
  theme_minimal() + 
  ylab("Ciśnienie wody [hPa]") + xlab("Temperatura [C]") +
  ggtitle('Zależność pomiędzy ciśnienem wody i temperaturą') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

ggplot(zad9, aes(x = Wilgotność, y = Opady_dzień)) + geom_hex(bins = 70)  + 
  scale_fill_gradient(low = "lightblue3", high = "deeppink3") +
  theme_minimal() + 
  ylab("Suma opadów w ciągu dnia [mm]") + xlab("Wilgotność [%]") +
  ggtitle('Zależność pomiędzy sumą opadów w ciągu dnia i wilgotnością') +
  theme(axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold"))

Za pomocą wykresów skrzynkowych

ggplot(przejazdy, aes(x = Month, y = Temperatura, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Temperatura") + xlab("Miesiąc") +
  ggtitle('Rozkład wartości temperatur względem miesiąca')

ggplot(przejazdy, aes(x = Month, y = Zachmurzenie, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Zachmurzenie") + xlab("Miesiąc") +
  ggtitle('Rozkład wartości zachmurzenia względem miesiąca')

ggplot(przejazdy, aes(x = Month, y = Wiatr, fill = Month)) + geom_boxplot(alpha = 0.8) + theme_bw() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1),
        axis.title.x = element_text(color="Grey40", size=16),
        axis.title.y = element_text(color="Grey40", size=16),                            
        legend.position = "none",
        strip.background = element_rect(colour = "black", fill = "white"),
        strip.text = element_text(face = "italic", size = 9),
        plot.title = element_text(color="grey40", size=19, family="serif", face = "bold")) +
  ylab("Wiatr") + xlab("Miesiąc") +
  ggtitle('Rozkład wartości siły wiatru względem miesiąca')

Za pomocą wykresów z pakitu ggridges()

ggplot(przejazdy, aes(x = Temperatura, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Temp. [C]", option = "B") +  
  theme_ridges() + labs(title = 'Temperatury w zależności od miesiąca') +
  xlab('Temparatura') + ylab("Miesiąc")

ggplot(przejazdy, aes(x = Ciśnienie_stacja, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Ciś. [hPa]", option = "E") +  
  theme_ridges() + labs(title = 'Ciśnienie powietrza w zależności od miesiąca') + xlab("Ciśnienie powietrza") +
  ylab("Miesiąc")

ggplot(przejazdy, aes(x = Wilgotność, y = Month, fill = stat(x))) +
  geom_density_ridges_gradient(scale = 3, rel_min_height = 0.01) +
  scale_fill_viridis_c(name = "Wilg. [%]", option = "D") +  
  theme_ridges() + labs(title = 'Wilgotność powietrza w zależności od miesiąca') + xlab("Wilgotność powietrza") +
  ylab("Miesiąc")

Za pomocą kalendarza z pakitu ggcalendR

doKalendarza <- przejazdy[przejazdy$Year == "2019" & przejazdy$Ciśnienie_stacja > 1022.0, ]
unique(doKalendarza$Data)

##  [1] "2019-01-03" "2019-01-06" "2019-01-07" "2019-02-04" "2019-02-05"
##  [6] "2019-02-06" "2019-02-14" "2019-02-15" "2019-02-16" "2019-02-22"
## [11] "2019-02-23" "2019-02-24" "2019-02-25" "2019-02-26" "2019-03-20"
## [16] "2019-03-21" "2019-03-22" "2019-03-23" "2019-03-27" "2019-03-28"
## [21] "2019-03-29" "2019-04-01" "2019-04-11" "2019-04-12" "2019-04-13"
## [26] "2019-04-14" "2019-04-15" "2019-04-16" "2019-04-17" "2019-04-18"
## [31] "2019-04-19" "2019-04-20" "2019-04-21" "2019-04-22" "2019-05-12"
## [36] "2019-05-13" "2019-05-14" "2019-05-15" "2019-05-30" "2019-06-09"
## [41] "2019-06-23" "2019-06-24" "2019-06-25" "2019-08-21" "2019-08-22"
## [46] "2019-08-23" "2019-08-24" "2019-08-25" "2019-08-26" "2019-09-12"
## [51] "2019-09-13" "2019-09-14" "2019-09-20" "2019-10-30" "2019-10-31"
## [56] "2019-12-27" "2019-12-28" "2019-12-29"

yday(unique(doKalendarza$Data))

##  [1]   3   6   7  35  36  37  45  46  47  53  54  55  56  57  79  80  81  82  86
## [20]  87  88  91 101 102 103 104 105 106 107 108 109 110 111 112 132 133 134 135
## [39] 150 160 174 175 176 233 234 235 236 237 238 255 256 257 263 303 304 361 362
## [58] 363

calendR(year = 2019,
        start = "M",
        special.days = c(3, 6, 7, 35,  36, 37, 45, 46, 47, 53, 54,  
                         55, 56, 57, 79, 80, 81, 82,  
                         86, 87, 88, 91, 101, 102, 103, 104, 105, 106, 107,
                        108, 109, 110, 111, 112, 132, 133, 134, 135, 150, 160, 
                        174, 175, 176, 233, 234, 235, 236, 237, 238, 255, 256, 257, 
                        263, 303, 304, 361, 362, 363),
        special.col = "deepskyblue3",
        low.col = "white",
        weeknames.col = "white",
        weeknames.size = 4,
        lty = 2,
        title = "Dni w 2019 roku z ciśnieniem powietrza powyżej 1022.0 hPa",
        title.size = 20,
        title.col = 'darkslateblue',
        mbg.col = 'lightgoldenrod3',
        bg.img = 'pressure.jpg',
        font.family = "sans",
        font.style = "plain")